home *** CD-ROM | disk | FTP | other *** search
- #include "slang.h"
- #include <stdio.h>
- #include <dos.h>
-
- #include <io.h>
- #include <FCNTL.H>
-
- ////////////////////////
- Slang::Slang()
- {
- error = 0; // Effor flag - not error number
- tok = 0; // Token type
- theName = NULL; // Used with arrays to keep name and index
- variables = new VarTable(); // Table of veriables
- for_used = 0; // FOR stack initialization
- sub_used = 0; // -//- gosub
- play_used = 0; // -//- external program files
- program = NULL; // Current program.
- labels = new label[NUM_LAB]; // Labels initialization
- }
- ///////////////////////////
- Slang::~Slang()
- {
- for(int i = 1; i <= play_used; i++) // Remove all unnecessary file
- delete playstack[i]; // names from play stack.
- delete labels;
- delete variables;
- delete program;
- delete theName;
- }
- ///////////////////////////
- void Slang::basic(char* p_buf) // p_buf contain program to run
- {
- prog = program = p_buf; // Set program and tracer.
- scan_labels(); // Remove old labels and search new
- if(error) // Check for labels error
- return;
- do
- interprete(); // Run program operand by operand
- while(tok != FINISHED && tok != END && !error);
- }
- ///////////////////////////////////////////////////////////////////////////
- void Slang::terminate()
- {
- }
- ///////////////////////////////////////////////////////////////////////////
- void Slang::interprete()
- {
- int oldtok;
- kh_error_code = KH_SUCCESS;
- do {
- terminate(); // User-defined STOP-event
- if(error) // Error detected
- {
- if(sub_used > 0)
- {
- prog = sub_pop();
- return;
- }
- while(play_used > 1) // We need clear all nested programs and
- delete playpop(); // "program" itself.
- delete program;
- program = NULL;
- delete variables; // We also clears all variables
- variables = new VarTable(); // and initialize them again.
- return;
- }
- token_type = get_token(); // Get next lexem
- if(token_type == VARIABLE) // If it is name (only x = ... or
- { // a[12]... recognized
- putback(); // Put it back to input stream and
- assigment(); // make assignment.
- }
- else
- switch(oldtok = tok) // If it is operator or subroutine call
- {
- case GOTO: slang_goto(); break; // This block is the
- case LABEL: find_eol(); break; // same in Slang and in
- case GOSUB: gosub(); break; // childs. It realize
- case PLAYEX: play(); break; // language facilities.
- case PRINT: print(); break;
- case IF: slang_if(); break;
- case FOR: slang_for(); break;
- case NEXT: next(); break;
- case INPUT: input(); break;
- case RETURN: sub_return(); break;
- case DELETE: del(); break;
- case PAUSE: pause(); break;
-
- case END: // End of "main" or played program.
- if(play_used == 1) // If it is main program, then
- return; // no action is taken.
-
- delete playpop(); // If we play external file, pop
- // it from program stack, and
- delete program;
- play_stack* p_s; // Then we load previous file
- program = load_program((p_s = playpop())->prog);
- prog = program + p_s->shift;
- delete p_s;
- scan_labels(); // And scan it for labels
- break;
- }
- } while((oldtok != FINISHED ) && (oldtok != RETURN));
- }
- //////////////////////
- void Slang::del() // for((str)a ? ... not supported
- {
- while(tok != EOL && tok != FINISHED && !error)
- {
- get_token(); // obtain variable name
- if(!isalpha(*token))
- { serror(4); return; }
- delete variables->remove(token);
- get_token();
- if(tok != EOL && token[0] != ',')
- { serror(0); return; }
- }
- }
- //////////////////////
- void Slang::assigment() // assignment or array initialization
- {
- if(error) // If error occured before call
- return;
- double value, index; // Value of REAL or index of ARRAY
- char name[80], *str_value; // Name of variable and STRING value
-
- get_token(); // Obtain variable name
- if(!isalpha(*token)) // If it is not variable name
- { serror(4); return; }
-
- strcpy(name, token); // Copy name to storage place
- get_token(); // '=' or [
- if(*token != '=' && *token != '[') // Only x = ... and a[12]; are
- { serror(18); return; } // legal
- if(*token == '[') // Array
- {
- get_exp(&index); // Array index could be expression too
- get_token(); // '=' or ';'
- if(*token != '=' && *token != ';') // = in assig. or ; in decl.
- { serror(18); return; }
-
- if(*token == ';') // ';' initializes array of 'index' elements
- {
- if(!variables->assign((int)index, name)) // Name is used by !ARRAY
- serror(20);
- return;
- }
- if(error || (get_exp(&value) != NULL)) // Value to assign
- {
- serror(2);
- return;
- }
- variables->assign((double)value, name, index);
- return;
- }
-
- get_token(); // '"...' or value of var
- if(token_type == QUOTE) // it is string
- variables->assign((char*)token, name);
- else // it is a = (real)b or a = (str)b
- {
- putback();
- str_value = get_exp(&value);
- switch(variable_type)
- {
- case REAL: variables->assign((double)value, name); break;
- case STR : variables->assign((char*)str_value, name); break;
- }
- }
- }
- //////////////////////
- void Slang::math(double* result)
- {
- if(error)
- return;
-
- double x;
- int t = tok;
- get_token(); // "("
- if(*token != '(')
- {
- serror(1);
- return;
- }
- get_token(); // sin argument
- if(token_type != VARIABLE && token_type != NUMBER)
- {
- serror(2);
- return;
- }
- putback();
- get_exp(&x); // if sin(2*x+1)
- switch(t)
- {
- case SIN: *result = sin(M_PI * 2 * x / 360); break;
- case COS: *result = cos(M_PI * 2 * x / 360); break;
- case TAN: *result = tan(M_PI * 2 * x / 360); break;
- case ASIN:
- if(x > 1 || x < -1)
- {
- serror(16);
- return;
- }
- *result = 180 * asin(x) / M_PI;
- break;
- case ACOS:
- if(x > 1 || x < -1)
- {
- serror(16);
- return;
- }
- *result = 180 * acos(x) / M_PI;
- break;
- case ATAN:
- *result = 180 * atan(x) / M_PI; break;
- case ABS: *result = abs(x); break;
- case EXP: *result = exp(x); break;
- case LOG: *result = log(x); break;
- case LG: *result = log10(x); break;
- default: serror(0);
- }
- }
- //////////////////////
- void Slang::pause()
- {
- if(error)
- return;
-
- #ifdef DOS_BGI
- double value;
- get_token();
- get_token();
-
- if(token_type == NUMBER || token_type == VARIABLE)
- {
- putback();
- get_exp(&value);
- delay(value);
- }
- else
- serror(0);
- #endif DOS_BGI
- }
- //////////////////////
- void Slang::print()
- {
- if(error)
- return;
-
- double value; char* str_value;
- int len = 0;
- do {
- get_token();
- if(tok == EOL || tok == FINISHED /* || tok == REMARK */ || error)
- break;
- switch(token_type)
- {
- case QUOTE: // it's string
- printf(token);
- len += strlen(token);
- get_token();
- break;
- default: // it's expression
- putback();
- str_value = get_exp(&value);
- switch(variable_type)
- {
- case REAL:
- case ARRAY: len += printf("%f", value); break;
- case STR : len += printf(str_value); break;
- }
- }
- switch(*token)
- {
- case ';': printf("\n"); break;
- case ',': break; // nonthing to do
- default :
- if(tok != EOL && tok != FINISHED)
- {
- serror(0);
- return;
- }
- }
- } while(*token == ';' || *token == ',');
- }
- ////////////////////
- void Slang::get_label() // Check label for errors and fill
- { // the table of labels.
- if(error) // If previus functions set
- return; // error flag - return
-
- int addr; // Number in the table
- get_token(); // Read label name
- addr = get_next_label(token); // -1 (overflov), -2 (duplicated labels)
- if(addr == -1) // or number of labels in table (index
- { // for new label in table.
- serror(5);
- return;
- }
- if(addr == -2)
- {
- serror(6);
- return;
- }
- strcpy(labels[addr].name, token);
- labels[addr].p = prog;
- }
- ////////////////////
- void Slang::scan_labels() // Scan program for labels
- {
- int addr; char* temp;
- label_init(); // Set all label names to zero
- temp = prog;
- do{ // In cycle, read token, if it is label,
- get_token(); // register it in get_label, else go to the
- if(error) // next line of program. This job should be
- return; // done only fr "main" code. Result is labels
- if(tok == LABEL) // in "main" function, and we now are at the
- { // first subroutine.
- get_label();
- find_eol();
- }
- } while(tok != END && tok != FINISHED);
- char* temp1 = prog;
- do { // Scan rest of code for labels
- get_token(); // and subroutines.
- if(tok == GOSUB)
- {
- get_label();
- find_return();
- find_eol();
- }
- } while(tok != FINISHED);
- prog = temp1;
- do { // Scan rest of code for labels
- get_token(); // and subroutines.
- if(tok == LABEL)
- {
- get_label();
- find_eol();
- }
- } while(tok != FINISHED);
-
- prog = temp;
- }
- ///////////////////////////
- void Slang::find_eol()
- {
- while(*prog != '\n' && *prog != '\0') ++prog;
- if(*prog) prog++;
- }
- //////////////////////////
- void Slang::find_return()
- {
- while(tok != RETURN)
- get_token();
- find_eol();
- }
- //////////////////////////
- int Slang::get_next_label(char* s)
- {
- int t;
- for(t = 0; t < NUM_LAB; ++t)
- {
- if(labels[t].name[0] == 0)
- return t;
- if(!strcmp(labels[t].name, s))
- return -2; // duplicated labels
- }
- return -1;
- }
- /////////////////////
- char* Slang::find_label(char* s)
- {
- int t;
- for(t = 0; labels[t].name[0] != '\0' && t < NUM_LAB; ++t)
- if(!strcmp(labels[t].name, s))
- return labels[t].p;
- return '\0';
- }
- //////////////////////
- void Slang::label_init()
- {
- int t;
- for(t = 0; t < NUM_LAB; ++t)
- labels[t].name[0] = '\0';
- }
- ////////////////////
- void Slang::slang_if() // if((str)a ? (str)b) not supported
- { // and if(f(x)) not supported and if(a AND (b OR c)) too
- if(error)
- return;
-
- double x, y; int cond; char op, op1;
- get_exp(&x); // left expression
- if(!strchr("=<>", *token))
- { serror(0); return; }
- op = *token; op1 = *(token + 1);
- get_exp(&y); // right expression
- cond = 0;
- switch(op) // =, >=, <=, =>, =<, <>,><
- {
- case '=':
- switch(op1)
- {
- case 0:
- if(x == y) cond = 1;
- break;
- case '>':
- if(x >= y) cond = 1;
- break;
- case '<':
- if(x <= y) cond = 1;
- break;
- }
- break;
- case '<':
- switch(op1)
- {
- case 0:
- if(x < y) cond = 1;
- break;
- case '=':
- if(x <= y) cond = 1;
- break;
- case '>':
- if(x != y) cond = 1;
- break;
- }
- break;
- case '>':
- switch(op1)
- {
- case 0:
- if(x > y) cond = 1;
- break;
- case '=':
- if(x >= y) cond = 1;
- break;
- case '<':
- if(x != y) cond = 1;
- break;
- }
- break;
- default: serror(0); return;
- }
- if(cond)
- {
- if(tok != THEN)
- {
- serror(8); return;
- }
- }
- else find_eol();
- }
- //////////////////////
- void Slang::slang_for() // for((str)a ? ... not supported
- {
- if(error)
- return;
- struct for_stack i;
- double value;
- get_token(); // obtain cycle variable
- if(!isalpha(*token))
- { serror(4); return; }
- strcpy(i.name, token);
- get_token(); // '='
- if(*token != '=')
- { serror(3); return; }
- get_exp(&value); // from
-
- variables->assign(value, i.name); //variableName);
- Variable* def = variables->find(i.name);
-
- if(tok != TO)
- { serror(9); return; }
- get_exp(&i.endval);
- if(value >= def->d)
- {
- i.entrance = prog;
- for_push(i);
- }
- else
- while(tok != NEXT)
- get_token();
- }
- ///////////////////////////
- void Slang::next()
- {
- if(error)
- return;
-
- struct for_stack i;
- i = for_pop();
-
- Variable* variableName = variables->find(i.name);
- variableName->d++;
-
- if(variableName->d > i.endval) return;
- for_push(i);
- prog = i.entrance;
- }
- //////////////////////////
- void Slang::for_push(struct for_stack i)
- {
- if(error)
- return;
-
- if(for_used > FOR_NEST)
- { serror(10); return; }
- fstack[for_used] = i;
- for_used++;
- }
- ///////////////////////
- for_stack Slang::for_pop()
- {
- for_used--;
- if(for_used < 0)
- serror(11);
- return(fstack[for_used]);
- }
- ///////////////////////
- void Slang::input()
- {
- if(error)
- return;
-
- double i; char str[80]; // input string
- get_token();
- if(token_type == QUOTE)
- {
- printf(token);
- get_token();
- if(*token != ',')
- { serror(0); return; }
- get_token();
- }
- else
- printf("? ");
- Variable* v = variables->find(token);
- switch(v->type)
- {
- case STR: // if exist (str)variable - assign str, else - real
- gets(str);
- variables->assign(str, token);
- break;
- case REAL:
- char t_token[80];
- strcpy(t_token, token);
- gets(str);
- char* temp = prog;
- prog = str;
- get_exp(&i);
- prog = temp;
- variables->assign(i, t_token);
- break;
- case ARRAY:
- strcpy(t_token, token); // t_token keep name
-
- double value;
- get_token();
- get_exp(&i); // i keeps index
-
- gets(str);
- temp = prog;
- prog = str;
- get_exp(&value); // value keeps input
- prog = temp;
- variables->assign(value, t_token, (int)i);
- break;
- }
- }
- ////////////////////////
- void Slang::slang_goto()
- {
- if(error)
- return;
-
- char* loc;
- get_token(); // name
- loc = find_label(token);
- if(loc == '\0')
- { serror(7); return; }
- prog = loc;
- }
- ////////////////////////
- void Slang::gosub()
- {
- if(error)
- return;
-
- char* loc;
- get_token(); // name
- loc = find_label(token);
- if(loc == '\0')
- { serror(7); return; }
- else
- {
- int arg1 = assign_arguments();
- sub_push(prog);
- prog = loc;
- int arg2 = reassign_arguments();
- if(arg1 != arg2)
- { serror(15); return; }
- interprete();
- }
- }
- //////////////////////
- void Slang::play() // Pass the control to the external file
- {
- if(error)
- return;
- get_token(); // "("
- if(*token != '(')
- {
- serror(1);
- return;
- }
-
- get_token(); // Name of file. !!! No error check !!!
- uint sh = prog - program;
- delete program; // Delete current program
- prog = program = load_program(token); // And replace it with new
- if(play_used > 1)
- playstack[play_used - 1]->shift = sh; //prog - program;
-
- scan_labels(); // Set new labels
- }
- //////////////////////
- void Slang::sub_return() // Return from subroutine
- {
- if(error)
- return;
-
- double value; char* str_value;
- get_token(); // If RETURN a
- if(token_type == DELIMITER) // EOL
- putback();
- else // If RETURN with parameters
- {
- putback();
- str_value = get_exp(&value);
- switch(variable_type)
- {
- case REAL: variables->assign(value, "retval"); break;
- case STR: variables->assign(str_value, "retval"); break;
- default: serror(0); break;
- }
- }
- prog = sub_pop();
- }
- /////////////////////
- void Slang::sub_push(char* s)
- {
- if(error)
- return;
-
- sub_used++;
- if(sub_used == SUB_NEST)
- { serror(12); return; }
- substack[sub_used] = s;
- }
- ////////////////////
- char* Slang::sub_pop()
- {
- if(sub_used == 0)
- serror(13);
- return(substack[sub_used--]);
- }
- /////////////////////////
- void Slang::playpush(char* s, int shift)
- {
- if(error)
- return;
-
- play_used++;
- if(play_used == SUB_NEST)
- { serror(12); return; }
- play_stack* p = new play_stack(s, shift);
- playstack[play_used] = p;
- }
- ////////////////////
- play_stack* Slang::playpop()
- {
- if(play_used == 0)
- serror(13);
- return (playstack[play_used--]);
- }
- /////////////////////////
- int Slang::assign_arguments()
- {
- if(error)
- return 0;
-
- double value; char* str_value; int i = 0; char num[10]; char name[10];
- get_token(); get_token(); // '(' and ')' ?
- while(*token != ')')
- {
- strcpy(name, itoa(i, num, 10)); // <= 20 arguments
- switch(token_type)
- {
- case QUOTE:
- variables->assign((char*)token, name);
- get_token(); // ',' or ')'
- i++;
- break;
- case NUMBER:
- case VARIABLE:
- putback();
- str_value = get_exp(&value);
- switch(variable_type)
- {
- case ARRAY:
- case REAL: variables->assign(value, name); break;
- case STR: variables->assign((char*)str_value, name); break;
- }
- i++;
- break;
- default: get_token();
- }
- }
- return i;
- }
- ///////////////////////
- int Slang::reassign_arguments()
- {
- if(error)
- return 0;
-
- char str_value[80]; int i = 0; char num[10];
- get_token(); // '('
- get_token(); // ')' ?
- while(*token != ')')
- {
- char name[10];
- strcpy(name, itoa(i, num, 10)); // <= 10 arguments
-
- Variable* inName = variables->find(name);
- if(inName->type == REAL)
- variables->assign(inName->d, token);
- else
- variables->assign(inName->s, token);
-
- i++; get_token(); // ',' or ')'
- if(*token == ',')
- get_token();
- }
- return i;
- }
- ///////////////////////
- char* Slang::load_program(char* filename)
- {
- if(error)
- return NULL;
-
- int f;
- if((f = open(filename, O_RDONLY | O_BINARY)) == -1)
- { serror(17); return NULL; }
-
- long fl = filelength(f);
- if (fl >= PROG_SIZE)
- {
- serror(21);
- close(f);
- return NULL;
- }
- char* p_buf = new char[fl + 3];
- int n = read(f, p_buf, fl);
- if(n < 0)
- {
- close(f);
- delete p_buf;
- p_buf = NULL;
- return NULL;
- }
- close(f);
-
- p_buf[fl] = '\r'; p_buf[fl + 1] = '\n'; p_buf[fl + 2] = '\0';
- playpush(filename, 0);
- return p_buf;
- }
-
- ////////////////////////////////// DOS Demo /////////////////////////////////
- /*
- #include <conio.h> // only for interruption on key pressed **************
- class Demo : public Slang
- {
- virtual void terminate(); // User-defined terminator (ESC and so on)
- };
- /////////////
- void Demo::terminate()
- {
- if(kbhit())
- {
- getch();
- if(kbhit())
- getch();
- serror(23);
- }
- }
- ///////////////////////////////////////////////////////////////////////////
- void main()
- {
- Demo* basic = new Demo();
- basic->basic(basic->load_program("work.bas"));
- delete basic;
- printf("%s", "\n");
- }
- //////////////////////////////// End of DOS Demo ////////////////////////////
- */